home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / zebu-follow.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  3.5 KB  |  93 lines  |  [TEXT/ttxt]

  1. ; -*- mode:     CL -*- ------------------------------------------------- ;
  2. ; File:         zebu-follow.l
  3. ; Description:  Conversion to CL of the original Scheme program by (W M Wells)
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:      31-Oct-90
  6. ; Modified:     Tue Jan 26 09:21:04 1993 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      ZEBU
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1990, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ; 20-Mar-91 (Joachim H. Laubsch)
  17. ;  Improved grammar debugging
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19. ;;;             Copyright (C) 1989, by William M. Wells III
  20. ;;;                         All Rights Reserved
  21. ;;;     Permission is granted for unrestricted non-commercial use.
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. (in-package "ZEBU")
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. ;;;
  26. ;;; Compute follow on a grammar symbol.
  27.  
  28. (defun calculate-follow-sets ()
  29.   (compute-follow-dependers)
  30.   (follow-insert-first-sets))
  31.  
  32.  
  33. ;;; Called initially on a production with prod being the production and
  34. ;;; prod-rhs being the rhs of the production.
  35. ;;; Returns true only if the prod-rhs derives the empty string, or is the
  36. ;;; empty string.  Fills in follow set dependencies by side effect.
  37.  
  38. (defun compute-follow-dependers (&aux prod)
  39.   (labels ((compute-follow-dependers-aux (prod-rhs)
  40.          (if prod-rhs
  41.          (let ((rhs-first (car prod-rhs)))
  42.            (when (compute-follow-dependers-aux (cdr prod-rhs))
  43.              (oset-insert! rhs-first
  44.                    (g-symbol-follow-dependers (lhs prod)))
  45.              ;; Return indication of whether tail derives empty string.
  46.              (g-symbol-derives-empty-string rhs-first)))
  47.            t)))
  48.     (do ((prods *productions* (cdr prods)))
  49.     ((null prods))
  50.       (setq prod (car (the cons prods)))
  51.       (compute-follow-dependers-aux (rhs prod)))))
  52.  
  53. (defun follow-insert-first-sets ()
  54.   (labels ((follow-insert-symbol (symbol-to-insert whose-follow-set)
  55.          ;; Both arguments are g-symbols.
  56.          (if (oset-insert! symbol-to-insert
  57.                    (g-symbol-follow-set whose-follow-set))
  58.          ;; Do it to his dependers too..
  59.          (dolist (depender (oset-item-list (g-symbol-follow-dependers
  60.                             whose-follow-set)))
  61.            (follow-insert-symbol symbol-to-insert depender))))
  62.        (follow-insert-first-sets-aux (prod-rest)
  63.          ;; Called on successive tails of the rhs of each production.
  64.          (when prod-rest
  65.            (let ((prod-rest2 (cdr prod-rest)))
  66.          (when prod-rest2
  67.            ;; prod-rest has at least two items
  68.            (dolist (symbol (oset-item-list (first-seq prod-rest2)))
  69.              (unless (eq symbol *empty-string-g-symbol*)
  70.                (follow-insert-symbol symbol (car prod-rest))))
  71.            (follow-insert-first-sets-aux prod-rest2))))))
  72.     (follow-insert-symbol *the-end-g-symbol* *start-symbol*)
  73.     (dolist (prod *productions*)
  74.       (follow-insert-first-sets-aux (rhs prod)))))
  75.  
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. ;;; test:
  78.  
  79. #||
  80. (set-working-directory *ZEBU-test-directory*)
  81. (load-grammar "ex2.zb")
  82. (compile-slr-grammar "ex2.zb")
  83. (ZEBU-LOAD-FILE "ex2.tab")
  84. (calculate-empty-string-derivers)
  85. (calculate-first-sets)
  86. (calculate-follow-sets)
  87. (cruise-follow-sets)
  88. ||#
  89.  
  90. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  91. ;;                               End of zebu-follow.l
  92. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  93.